64'er/64ER_CD.iso/89xx/8907a.d64/declare 88 src

Commodore BASIC | 1995-03-30 | 21.0 KB | 590 lines

0 POKE53280,11:POKE53281,15:PRINTCHR$(144):END
10 SYS9*4096:.OPT OO:*=$C000
20 ; *** PROGRAMMTEILADRESSEN ***
29 PRG0A = $7300:PRG0E = $73FF
30 PRG1A = $C000:PRG1E = $C3FF
34 PRG3A = $8000:PRG3E = $83FF
35 PRG4A = $D400:PRG4E = $D7FF
150 LO = 167:HI = 168:LO2 = 169:HI2 = 170
155 STRPT = 178;179:COUNTER = 180;181
156 STARTADR = 250
160 DATA = $83:REM = $8F:PRINT = $99
180 PNT2 = $49:CHAROUT = $AB47
200 CHAR = 8:COUNT = 11:PNT = $71
230 QUOTE = $22:FLAG = 15:TXTPTR = $7A
260 BUFFER = $200:TABLE = $A09E
265 READY = $A474:CKCOM = $AEFD
270 SPEICHER = $7000:CASSETTE = 828
301 ; NEUE COMMANDS
303 CMDSTART = $CC:CMDLAST = $D1:FUNEND = $FF
375 ; *********************
376 ; *** PROGRAMMTEIL1 ***
378 ; *** INTERPRETER NEU ***
440 TOKENREAD LDX TXTPTR:LDY #4:STY FLAG
450 JSR DOWN:JSR NEXTCHAR:PHA:JSR UP:PLA:JMP $A609
570 ; FUER VERGLEICH MIT TABLE AUFTAUCHEN
580 L575 JSR UP:JSR COMPARE:JMP DOWN; BACK TO NEXTCHAR
2000 ; *** NEUE LIST-ROUTINE ***
2030 TOKENLIST BPL OUT
2033 BIT FLAG:BMI OUT;QUOT-MODUS
2035 CMP #$FF:BEQ OUT
2040 CMP #$CC:BCS NEWLIST
2050 JMP $A724:OUT JMP $A6F3
2055 NEWLIST CMP CMDEND:BCC L2060
2058 SBC FUNSTART:CLC:ADC CMDEND
2060 L2060 SEC:SBC #$CB:TAX:STY PNT2
2065 LDA #<(NEWTAB-1):STA LO:LDA #>(NEWTAB-1):STA HI:LDY #0:BEQ L2085
2080 LOOP INY:BNE L2080:INC HI:L2080 LDA (LO),Y:BPL LOOP
2085 L2085 DEX:BNE LOOP
2090 FOUND INY:BNE L2095:INC HI
2095 L2095 LDA (LO),Y:BMI OLDEND:JSR CHAROUT:BNE FOUND
2100 OLDEND JMP $A6EF
3000 ; *** COMMANDS AUSFUEHREN ***
3020 TYPFLAG = 13:CHRGET = $73:CHR(null)T = CHRGET+6
3030 EXECOLD = $A7ED:INTER = $A7AE:FUNKTOLD = $AE8D
3040 GETTERM = $AEF1:CHECKNUM = $AD8D
3050 ; *** PROCEDURES ***
3110 NEWCMD JSR CHRGET:JSR TESTCMD:JMP INTER
3120 TESTCMD CMP #CMDSTART:BCC OLDCMD:CMP CMDEND:BCC CMD2
3130 OLDCMD JSR CHR(null)T:JMP EXECOLD
3140 CMD2 SEC:SBC #CMDSTART:ASL:TAY
3145 LDA #<CMDTAB:STA LO:LDA #>CMDTAB:STA HI
3150 INY:LDA (LO),Y:DEY:PHA:LDA (LO),Y:PHA:JMP CHRGET
3155 ; *** FUNCTIONS ***
3160 NEWFUN LDA #0:STA TYPFLAG:JSR CHRGET:CMP FUNSTART:BCC OLDFUN
3170 CMP #FUNEND:BCC FUN2
3180 OLDFUN JSR CHR(null)T:JMP FUNKTOLD
3190 FUN2 SEC:SBC FUNSTART:ASL:CLC:ADC FUNTABANF:STA JUMPIND+1
3192 LDA FUNTABANF+1:ADC #0:STA JUMPIND+2
3194 JSR CHRGET:JSR GETTERM:JSR JUMPIND:JMP CHECKNUM
3210 JUMPIND JMP ($FFFF)
3300 ; *****************************
3302 ; *** PROCEDURE DEKLARIEREN ***
3312 PROCEDURE LDA #1:JSR DECLARE
3314 PROC2 INC CMDEND
3320 LDA FUNSTRANF:CLC:ADC STRLEN:STA FUNSTRANF:BCC L3338:INC FUNSTRANF+1
3338 L3338 LDA FUNTABANF:CLC:ADC #2:STA FUNTABANF:BCC L3342:INC FUNTABANF+1
3342 L3342 RTS
3400 ; ****************************
3402 ; *** FUNKTION DEKLARIEREN ***
3411 FUNCTION LDA #0:JSR DECLARE
3420 FUNCT2 DEC FUNSTART:RTS
3510 ; ******************************
3511 ; ** FUN/PROC/PACK NAME LESEN **
3520 TITLE JSR STREVL:STA TITLEN:STY TITPOINT+1:STX TITPOINT
3525 JSR $E200:STX DEVICE:LDA #0:STA ADRESSEN:RTS
3530 ; ******************************
3531 ; TEST, OB CMD DEKL. WERDEN KANN
3532 ; NAME IM BUFFER
3535 DEKLTEST JSR COMPARE:BNE ERROR19; REDEFINITION
3540 ; TESTEN, OB NUMMER FREI
3542 LDA FUNSTART:CMP CMDEND:BEQ ERROR16:RTS
3550 ERROR16 LDX #16; OUT OF (null) :.BYTE $2C
3552 ERROR19 LDX #19:JMP ERROR; REDIM ERROR
3598 ; ********************************
3599 ; ** PROC/FUN LADEN/ASSEMBLIEREN *
3600 DECLARE STA TYPE:JSR TITLE:JSR DEKLTEST
3601 JSR VORB; CKCOM/OPFILE
3615 JSR INPSTRING;DOWN
3630 JSR DECL2; HEADER UND PRGTEIL
3693 ; ** COMMAND (TITLE) EINBAUEN
3695 LDA TITPOINT:STA STRPT:LDA TITPOINT+1:STA STRPT+1
3698 LDA TITLEN:STA STRLEN:JSR EINBAUEN:JMP UP
3700 ; ********************************
3701 ; ** ZEICHENKETTE NACH (STRPT)  **
3703 ; **   ENDE MIT DOPPELPUNKT    **
3704 ; ** KEHRT IN DOWN-MODE ZURUECK **
3710 INPSTRING JSR UP:LDA DEVICE:BNE L3716
3712 JSR STREVL:JMP DOWN; DEVICE 0
3716 L3716 LDA COMMEND:STA STRPT:LDA COMMEND+1:STA STRPT+1:LDY #0
3718 ; *** HEADER MUSS GEHOLT WERDEN
3720 L3720 LDA DEVICE:CMP #1:BEQ L3725
3721 ; *** .ASC VON DISK  **
3722 JSR $E112:BIT 144:BVC L3728
3723 L3723 LDX #11:JMP ERROR; SYNTAX
3724 ; *** .ASC IM SPEICHER ABGELEGT **
3725 L3725 LDA (STARTADR),Y
3728 L3728 STA (STRPT),Y:INY:BEQ L3723:CMP #":":BNE L3720
3730 TYA:STA STRLEN
3732 L3732 CLC:ADC STARTADR:STA STARTADR:BCC L3734:INC STARTADR+1
3734 L3734 JMP DOWN
3777 ; ********************************
3778 ; * STRING AUSWERTEN, STRPT SETZEN
3780 STREVL JSR $AD9E:JSR $B6A3:STA STRLEN:STY STRPT+1:STX STRPT:RTS
4000 ; ************************
4001 ; *** PACK DEKLARIEREN ***
4012 PACK JSR TITLE:LDA COMMEND:STA PRGANF:LDA COMMEND+1:STA PRGANF+1
4035 LDA #2:STA TYPE:JSR VORB; CKCOM/OPFILE
4105 JSR INPSTRING;DOWN
4110 JSR PAC2; HEADER,PRGTEIL HOLEN:JMP UP
4160 ; ** AUS PAC2 FUER DEKLTEST AUFTAUCHEN
4165 L4165 JSR UP:JSR DEKLTEST:JMP DOWN; BACK NACH PAC2
4200 ; *****************************
4201 ; ** HEADER-READ VORBEREITEN **
4202 VORB LDA DEVICE:BEQ L4218
4204 CMP #8:BEQ L4214
4206 ; *** DEVICE 1, AUS SPEICHER - STARTADR HOLEN
4208 JSR CKCOM:JSR $AD8A:JSR $BC9B
4210 LDA $65:STA STARTADR:LDA $64:STA STARTADR+1:RTS
4212 ; ** NUR DEVICE 8
4214 L4214 JMP OPFILE;RTS
4216 ; ** NUR DEVICE 0
4218 L4218 JMP CKCOM;RTS
4300 ; ******************************
4301 ; * UP,PROGRAMMTEIL HOLEN,DOWN *
4310 INPRG JSR UP:LDA DEVICE:BEQ L4316:CMP #1:BEQ L4320
4313 ; ** NUR DEVICE 8
4314 JMP INFILE;LOAD,DOWN,ANPASSEN
4315 ; ** NUR DEVICE 0
4316 L4316 JMP ASMPRG; ASSEMBLIEREN,DOWN
4318 ; *** NUR DEVICE 1 - NACH COMMEND KOPIEREN ,DOWN, ANPASSEN
4320 L4320 LDY #0:LDA (STARTADR),Y:STA ENDADR:INY:LDA (STARTADR),Y:STA ENDADR+1
4322 LDA #2:JSR L3732; STARTADRESSE+ACCU, DOWN
4326 ; *** 4328-4336 DOWN-MODE ***
4328 L4328 LDA COMMEND:STA LO:LDA COMMEND+1:STA HI
4329 LDA STARTADR:STA LO2:LDA STARTADR+1:STA HI2:LDY #0
4330 L4330 LDA (LO2),Y:STA (LO),Y
4332 INC LO2:BNE L4333:INC HI2
4333 L4333 INC LO:BNE L4334:INC HI
4334 L4334 SEC:LDA LO2:SBC ENDADR:LDA HI2:SBC ENDADR+1:BCC L4330
4336 JMP ADRANP
5101 ; ********************************
5102 ; STRING (STRPT) MIT TABLES VERGL.
5103 ;ERGEBNIS A>0 COUNT-NR DES TOKENS
5104 ;        A=0 TOKEN NICHT DEFINIERT
5110 ; *** MIT ROM-TABLE ***
5120 COMPARE LDA #0:STA COUNT
5122 LDA #>TABLE:STA HI:LDA #<TABLE:STA LO:JSR COMPSUB:BNE L5274
5130 ; *** MIT NEWTAB ***
5140 COMPARE2 LDA #>NEWTAB:STA HI:LDA #<NEWTAB:STA LO
5142 LDA #CMDSTART:STA COUNT
5220 ; ********************************
5222 ; ** MIT TABLE (LO/HI) VERGLEICHEN
5230 COMPSUB LDA #0:STA COMPLEN
5245 L5245 LDY #0
5248 L5248 LDA (STRPT),Y:SEC:SBC (LO),Y:INY:AND #$FF:BEQ L5248
5250 CMP #$80:BEQ L5270
5251 INC COUNT:DEY:DEY
5252 L5252 INY:LDA (LO),Y:BPL L5252:INY:LDA (LO),Y:BEQ L5272
5255 TYA:CLC:ADC LO:STA LO:BCC L5245:INC HI:BNE L5245
5270 L5270 ORA COUNT:STY COMPLEN
5272 L5272 STA COUNT
5274 L5274 RTS
5500 ; ********************
5501 ; *** MEMORY-DUMP  ***
5504 MEMORY LDA #<NEWTAB:STA LO:LDA #>NEWTAB:STA HI:LDY #0
5506 L5506 LDA (LO),Y:BEQ L5520:BPL L5512
5510 L5510 AND #127:JSR $F1CA:LDA #13
5512 L5512 JSR $F1CA:INY:BNE L5506:INC HI:BNE L5506
5518 ; *** ANFANG UND ENDE DES PROCEDURESPEICHERS ***
5520 L5520 LDA COMMANDS+1:LDX COMMANDS:JSR $BDCD
5522 LDA #"-":JSR $F1CA
5524 LDA COMMEND+1:LDX COMMEND:JMP $BDCD
5600 ; *******************************
5601 ; *** ASCII-ZAHL IM BUFFER -> INT
5602 ; *** AUS DOWN, ENDE MIT DOWN
5604 BUFFINT JSR UP:LDA $7A:PHA:LDA $7B:PHA
5606 LDA STRPT+1:STA $7B:LDA STRPT:STA $7A:JSR $0079:JSR $BCF3:JSR $BC9B
5608 LDA $7A:STA STRPT:LDA $7B:STA STRPT+1
5610 PLA:STA $7B:PLA:STA $7A:JMP DOWN
6200 ; ********************************
6201 ; ** PROGRAMMTEIL VON DISK LESEN *
6202 ; ** UND ADRESSEN ANPASSEN       *
6216 INFILE LDA COMMEND:STA LO:LDA COMMEND+1:STA HI
6220 BASIN JSR $FFCF:LDY #0:STA (LO),Y
6224 INC LO:BNE L6226:INC HI
6226 L6226 BIT 144:BVC BASIN
6240 ; *** FILE SCHLIESSEN ***
6244 L6244 JSR CLOSE:JSR DOWN:JMP ADRANP
6300 ; ***************************
6301 ; *** OBJECT FILE OEFFNEN ***
6302 ; FILENAME KOMPLETTIEREN
6303 OPFILE LDA #1:JSR $FFC3;FILE1 SCHLIESSEN
6304 LDA #1:LDX DEVICE:LDY #2:JSR $FFBA:LDY #0:LDX #0
6306 L6306 LDA (STRPT),Y:STA CASSETTE,Y:INY:CPY STRLEN:BNE L6306
6308 L6308 LDA TYPE:CMP #2:BEQ L6312
6309 ; *** NAME.OBJ ***
6310 LDA OBJSTR,X:BNE L6314
6311 ; *** NAME.PAC ***
6312 L6312 LDA PACSTR,X
6314 L6314 STA CASSETTE,Y:INY:INX:CPX #4:BNE L6308
6315 ; ** FILE OPEN **
6316 L6316 TYA:LDX #<CASSETTE:LDY #>CASSETTE:JSR $FFBD:JSR $FFC0
6320 ; ** ERROR CONTROL #2,8,15 **
6322 LDA #2:LDX DEVICE:LDY #15:JSR $FFBA
6324 LDA #0:JSR $FFBD:JSR $FFC0:LDX #2:JSR $FFC6
6326 JSR $FFCF:CMP #48:BEQ L6328:LDX #4:JMP ERROR; FILE NOT FOUND
6328 L6328 JSR $FFCC:LDX #1:JSR $FFC6; FILE1
6330 JSR $FFCF:STA STARTADR:JSR $FFCF:STA STARTADR+1:RTS
6410 ; *************************
6411 ; *** CLOSE FILES #1,#2 ***
6412 CLOSE JSR $FFCC:LDA #1:JSR $FFC3:LDA #2:JSR $FFC3:JMP $FD15
6420 ; *****************************
6422 ; *** ERROR AUS RAM EBENE 2 ***
6424 ERROR JSR UP:TXA:PHA:JSR CLOSE:PLA:TAX:JMP $A43A
6500 ; *****************************
6501 ; *** SYSTEM INITIALISIEREN ***
6510 INIT JSR DOWN:JMP L16504
6600 ; *****************************
6601 ; *** SPEICHERKONFIGURATION ***
6610 DOWN SEI:LDA 1:AND #248:STA 1:RTS
6612 UP LDA 1:ORA #7:STA 1:CLI:RTS
7450 ; *****************************
7451 ; *** PROGRAMM ASSEMBLIEREN ***
7452 ; STARTADRESSE HINTERLEGEN
7454 ASMPRG TSX:STX VAR:JSR DOWN:JSR L16304
7460 JMP $9000
7461 ; ASSEMBLER NORMALISIEREN
7462 BACK JSR DOWN:JSR L16312
7469 ; WIEDER IN ASM SPRINGEN
7470 JSR $9DDB:TSX:CPX VAR:BNE L7472:JMP DOWN; RTS
7472 L7472 JMP READY
7500 ; ** LEERBYTES BIS VARIABLENANF.
9000 ; ************************
9001 ; *** VARIABLENBEREICH ***
9002 *=$C480 ; 48 BYTES - $C4B0
9020 TYPE .BYTE $FF
9025 COMMANDS .WORD SPEICHER:COMMEND .WORD SPEICHER
9304 CMDEND .BYTE CMDLAST; +5 (PROC+FUN+IN+MEM+PAC)
9305 FUNSTART .BYTE FUNEND
9307 FUNSTRANF .WORD FUNSTRTAB
9308 FUNSTREND .WORD FUNSTRTAB
9310 FUNTABANF .WORD FUNTAB
9312 FUNTABEND .WORD FUNTAB
9315 ENDADR .WORD 00   ; ALTES PROGRAMM
9317 PRGANF .WORD 00   ; DES NEUEN
9318 PRGEND .WORD 00   ; PROGRAMMS
9368 TITPOINT .WORD 00:TITLEN .BYTE 0
9369 STRLEN .BYTE 0
9371 COMPLEN .BYTE 0:INSANF .WORD 00
9372 ADRESSEN .BYTE 00:USADR .WORD 00
9373 DEVICE .BYTE 00:VAR .BYTE 00
9375 OBJSTR .ASC ".OBJ"
9376 PACSTR .ASC ".PAC"
10000 ; *********************
10001 ; *** PROGRAMMTEIL2 ***
10002 ; *********************
10100 *=$8000
10350 ; ***************************
10352 ; *** INTERPRETER PART II ***
10380 NEXTCHAR LDA BUFFER,X:BPL NORMAL:INX:CMP #$FF:BNE NEXTCHAR:DEX
10410 ; * ALLE ZEICHEN <128 UND $FF=(null) *
10440 NORMAL BIT FLAG:BVS TAKCHAR;DATAZEILE
10490 CMP #"?":BEQ CHR63
10560 ; *** AUF TOKENS TESTEN ***
10570 CHECKTOKEN STY PNT:STX TXTPTR
10575 STX STRPT:LDA #2:STA STRPT+1:JSR L575; COMP MIT TABLES
10576 LDA COMPLEN:CLC:ADC TXTPTR:TAX:LDY PNT
10580 LDA COUNT:BEQ NOTFOUND:DEX:CMP CMDEND:BCC TAKCHAR
10585 SEC:SBC CMDEND:CLC:ADC FUNSTART:BNE TAKCHAR
10590 ; *******************
10710 CHR63 LDA #PRINT:BNE TAKCHAR
10715 ; *******************
10720 NOTFOUND LDA BUFFER,X
10730 ; *** ZEICHEN UEBERNEHMEN ***
10731 ; UND AUF ":",DATA,REM TESTEN
10740 TAKCHAR INX:INY:STA BUFFER-5,Y
10760 CMP #0:BEQ ENDE; * ZEILENENDE *
10770 ; ** TEST AUF HOCHKOMMA **
10771 CMP #QUOTE:BEQ CHR34
10780 ; ** TEST AUF ":" **
10781 CMP #":":BNE L10791:LDA #0:STA FLAG
10790 ; ** TEST AUF DATA **
10791 L10791 CMP #DATA:BNE L10801:LDA #64:STA FLAG
10800 ; ** TEST AUF REM **
10801 L10801 CMP #REM:BNE NEXTCHAR
10810 ; ******************
10845 CHR34 STA CHAR
10850 ; *** TEXT UEBERNEHMEN ***
10860 COPYTEXT LDA BUFFER,X:INY:INX:STA BUFFER-5,Y
10870 CMP CHAR:BEQ NEXTCHAR:CMP #0:BNE COPYTEXT
10875 ENDE RTS; ZEILENENDE
12900 ; *********************
12901 ; ** FILE BEARBEITEN **
12910 L12910 LDX #11:JMP ERROR; SYNTAX
12920 ; *** HEADER LESEN ***
12921 ; *** "NUR BEI PACK:"
12922 ; ** "PROCEDURE ODER FUNCTION"
12975 PAC2 JSR COMPARE2:SEC:SBC #CMDSTART:CMP #2:BCS L12910
12990 EOR #1:STA TYPE:LDA COMPLEN:JSR ADDSTRP:JSR NEXTCHR:CPX #32:BNE L12910
13004 JSR L4165; DEKLTEST UP:LDY #$FF
13010 ; *** STRLEN BESTIMMEN ***
13012 L13012 INY:LDA (STRPT),Y:BEQ L12910:CMP #QUOTE:BEQ L12910
13014 CMP #",":BEQ L13020:CMP #":":BNE L13012
13020 L13020 STY STRLEN:JSR EINBAUEN:LDA STRLEN:JSR ADDSTRP
13030 LDA TYPE:BEQ L13030:JSR PROC2:BNE L13040:L13030 JSR FUNCT2
13040 L13040 LDA PRGANF:CLC:ADC #3:STA PRGANF:BCC L13045:INC PRGANF+1
13045 L13045 JSR NEXTCHR:CPX #",":BEQ PAC2:CPX #":":BNE L12910
13060 LDA DEVICE:BEQ DECL2:JSR INPSTRING
13100 ; *************************
13102 ; * 'PROGRAM' ODER 'USING'
13104 ; * "PACK" UND SOLO-DEKLARATIONEN
13108 DECL2 JSR TXVERGL; X 0=US,1=PRG:TXA:BNE L13210
13110 JSR NEXTCHR:CPX #32:BNE L13452
13115 ; ** USING-STATEMENT BEARBEITEN
13120 L13120 JSR COMPARE2:BEQ L13450
13124 LDA COMPLEN:JSR ADDSTRP
13126 JSR NEXTCHR:CPX #",":BNE L13452
13128 JSR USINGADR:JSR BUFFINT
13135 LDA USADR:CLC:ADC $65:PHA:LDA USADR+1:ADC $64:PHA:INC ADRESSEN
13140 JSR NEXTCHR:CPX #",":BEQ L13120:CPX #":":BNE L13452; SYNTAX
13142 LDA DEVICE:BEQ L13144:JSR INPSTRING
13143 ; ** HEADER-TEST AUF "PROGRAM:"
13144 L13144 JSR TXVERGL:TXA:BEQ L13452
13200 ; ** "PROGRAM:" -> PRGTEIL LADEN
13210 L13210 JSR NEXTCHR:CPX #":":BNE L13452
13212 LDA COMMEND:STA PRGANF:LDA COMMEND+1:STA PRGANF+1:JSR INPRG
13220 ; * GGF. USING-ADRESSEN EINSETZEN
13221 ; * USINGAUSW NICHT MIT JSR
13226 LDA ADRESSEN:BEQ L13230:JMP USINGAUSW; MIT JMP ZURUECK
13228 ; ** COMMANDS-ENDE SETZEN
13230 L13230 LDA PRGEND:STA COMMEND:LDA PRGEND+1:STA COMMEND+1:RTS
13430 ; *********************
13431 ; ** FEHLERMELDUNGEN **
13450 L13450 LDX #17:.BYTE $2C; UNDEF'D STATEMENT
13452 L13452 LDX #11:JMP ERROR; SYNTAX
13500 ; *******************************
13501 ; * (STRPT) MIT 'USING','PROGRAM'
13502 ; * VERGL. X -> 0=USING,1=PROGRAM
13510 TXVERGL LDA #>USTAB:STA HI:LDA #<USTAB:STA LO:LDA #0:STA COUNT
13520 JSR COMPSUB:BEQ L13452
13524 AND #1:TAX:LDA COMPLEN:BNE ADDSTRP;RTS
13600 ; ******************************
13601 ; * NEXT CHAR BEI (STRPT) -> X *
13602 ; * UND STRPT INCREMENT
13605 NEXTCHR LDY #0:LDA (STRPT),Y:TAX:LDA #1
13608 ; *** AKKU ZU STRPT ADDIEREN **
13610 ADDSTRP CLC:ADC STRPT:STA STRPT:BCC L13612:INC STRPT+1
13612 L13612 RTS
13708 ; ****************************
13709 ; * COMMAMD (STRP) EINBAUEN **
13710 ; * STRINGTABELLE SCHIEBEN
13711 ; * FUNSTREND + LEN
13712 EINBAUEN LDX STRLEN:LDA FUNSTRANF:STA INSANF:LDA FUNSTRANF+1:STA INSANF+1
13714 LDA FUNSTREND:STA LO:CLC:ADC STRLEN:STA FUNSTREND
13716 LDA FUNSTREND+1:STA HI:ADC #0:STA FUNSTREND+1:JSR INSERT
13720 ; *** STRING IN NEWTAB ***
13721 LDY #0
13722 L13722 LDA (STRPT),Y:STA (LO),Y:INY:CPY STRLEN:BNE L13722
13724 DEY:LDA (LO),Y:ORA #$80:STA (LO),Y
13738 ; * ADRESSENTABELLE SCHIEBEN
13739 ; * FUNTABEND + 2
13740 LDX #2:LDA FUNTABANF:STA INSANF:LDA FUNTABANF+1:STA INSANF+1
13742 LDA FUNTABEND:STA LO:CLC:ADC #2:STA FUNTABEND
13750 LDA FUNTABEND+1:STA HI:ADC #0:STA FUNTABEND+1:JSR INSERT
13778 ; *** ANF.ADR IN TABELLE ***
13779 ; *** PROCS    ADR=ANF-1 ***
13780 LDY #0:SEC:LDA PRGANF:SBC TYPE:STA (LO),Y:INY
13784 LDA PRGANF+1:SBC #0:STA (LO),Y:RTS
14725 ; *******************************
14732 ; ** USING-ADRESSE NACH USADR  **
14733 ; IN COUNT USING-TOKEN-NR
14740 USINGADR LDA COUNT:SBC #CMDSTART:ASL A:TAY
14742 LDA CMDEND:CLC:SBC COUNT
14750 ; PROC -> CARRY SET -> ADRESSE+1
14752 ; FUNC -> CARRY CLR -> ADRESSE+0
14770 ; * TAB-ADRESSE +CARRY -> USADR *
14772 LDA #<CMDTAB:STA LO:LDA #>CMDTAB:STA HI
14773 LDA (LO),Y:ADC #0:STA USADR
14774 INY:LDA (LO),Y:ADC #0:STA USADR+1:RTS
14800 ; *****************************
14801 ; * PROGRAMMTEIL VON DISK     *
14802 ; * TEIL2 - ADRESSEN ANPASSEN *
14845 ADRANP LDA COMMEND:STA COUNTER:LDA COMMEND+1:STA COUNTER+1
14850 ; ** PRGLEN (A/Y)= HI/LO-PRGANF
14852 LDA LO:STA PRGEND:SEC:SBC PRGANF:TAX;PRGLEN-LO
14854 LDA HI:STA PRGEND+1:SBC PRGANF+1:TAY;PRGLEN-HI
14860 ; ** ENDADR=STARTADR+PRGLEN (A/Y)
14862 TXA:CLC:ADC STARTADR:STA ENDADR
14864 TYA:ADC STARTADR+1:STA ENDADR+1
14900 ; *******************************
14902 ; ** ABSOLUTE ADRESSEN SUCHEN ***
14903 ; ** BIS UNBRAUCHBARES ZEICHEN **
14904 ; ** Z.B. $FF **
14910 ADAPT LDY #0:LDA (COUNTER),Y:CMP #$FF:BEQ L4924:TAX:DEY
14911 L14911 INY:TXA:AND MASKTAB,Y:CMP BITTAB,Y:BNE L14911
14914 LDA LENTAB,Y:CMP #3:BNE L4918:PHA:JSR ABSOLUT:PLA
14918 L4918 CLC:ADC COUNTER:STA COUNTER:BCC L4920:INC COUNTER+1
14920 L4920 SEC:SBC PRGEND:LDA COUNTER+1:SBC PRGEND+1:BCC ADAPT
14924 L4924 RTS
14950 ; *** ABSOLUTE ADR < STARTADRESSE
14954 ABSOLUT LDY #1:SEC:LDA (COUNTER),Y:SBC STARTADR
14956 INY:LDA (COUNTER),Y:SBC STARTADR+1:BCC L4988
14965 ; *** ABS.ADR > ENDADRESSE
14970 LDY #1:SEC:LDA ENDADR:SBC (COUNTER),Y
14972 INY:LDA ENDADR+1:SBC (COUNTER),Y:BCC L4988
14980 ; *** ABS.ADR. ANPASSEN ***
14982 L4982 LDY #1:LDA (COUNTER),Y:SEC:SBC STARTADR:TAX; LO
14984 INY:LDA (COUNTER),Y:SBC STARTADR+1:PHA; HI
14986 DEY:TXA:CLC:ADC PRGANF:STA (COUNTER),Y
14988 INY:PLA:ADC PRGANF+1:STA (COUNTER),Y:L4988 RTS
14995 ; *****************************
14996 ; **  USING-PLAETZE SUCHEN    *
14997 ; ** ADRESSEN AUS STACK HOLEN *
15001 ; **  UND EINSETZEN           *
15002 USINGAUSW TSX:TXA:CLC:ADC ADRESSEN:ADC ADRESSEN:TAX:TXS
15004 LDA PRGANF:STA COUNTER:LDA PRGANF+1:STA COUNTER+1
15005 L15005 LDY #0:LDA (COUNTER),Y:INY:AND (COUNTER),Y:CMP #$FF:BEQ ADREIN
15008 INC COUNTER:BNE L15010:INC COUNTER+1
15010 L15010 SEC:LDA COUNTER:SBC PRGEND:LDA COUNTER+1:SBC PRGEND+1:BCC L15005
15015 ; ** KEIN PLATZ FUER USING-ADR **
15020 LDX #13:JMP ERROR; OUT OF DATA ERROR
15028 ; ** ADR AUS STACK-BEREICH HOLEN
15030 ADREIN LDA $0100,X:DEY:STA (COUNTER),Y
15032 INY:DEX:LDA $0100,X:STA (COUNTER),Y:DEX
15034 DEC ADRESSEN:BNE L15005:JMP L13230; PRAKTISCH RTS
15600 ; *** PLATZ SCHAFFEN ***
15601 ; ** IM X-REG ANZAHL ***
15602 ; ** VON INSANF BIS LO/HI **
15603 INSERT STX VAR
15605 L5605 LDY #0:LDA (LO),Y:LDY VAR:STA (LO),Y
15610 SEC:LDA INSANF:SBC LO:LDA INSANF+1:SBC HI:BCS L5620
15615 DEC LO:LDA LO:CMP #$FF:BNE L5605:DEC HI:BNE L5605
15620 L5620 RTS
16500 ; *****************************
16501 ; *** SYSTEM INITIALISIEREN ***
16504 L16504 LDA #CMDLAST:STA CMDEND:LDA #FUNEND:STA FUNSTART
16506 LDA #<FUNSTRTAB:STA FUNSTRANF:STA FUNSTREND
16507 LDA #>FUNSTRTAB:STA FUNSTRANF+1:STA FUNSTREND+1
16510 LDA #<FUNTAB:STA FUNTABANF:STA FUNTABEND
16511 LDA #>FUNTAB:STA FUNTABANF+1:STA FUNTABEND+1
16515 LDA COMMANDS:STA COMMEND:LDA COMMANDS+1:STA COMMEND+1
16518 LDA #0:STA FUNTAB:STA FUNTAB+1:STA FUNSTRTAB:STA FUNSTRTAB+1:JMP UP
17050 ; *** DISASS-DATEN ***
17051 ; BYTES PRO BEFEHL $00 - $FF
17052 .BYTE $FF
17060 MASKTAB .BYTE %00001100;$XC,XD,XE,XF
17061 .BYTE %11111111;$20
17062 .BYTE %10011111;$00,40,60
17063 .BYTE %00001000;$X0-X7
17064 .BYTE %00001101;$X8,XA
17065 .BYTE %00011101;HI 2X+LO 9,B
17066 .BYTE %11011111;$9B,BB
17067 .BYTE %00011101;HI(2X+1)+LO 9,B
17070 BITTAB .BYTE %00001100
17071 .BYTE %00100000
17072 .BYTE %00000000
17073 .BYTE %00000000
17074 .BYTE %00001000
17075 .BYTE %00001001
17076 .BYTE %10011011
17077 .BYTE %00011001
17080 LENTAB .BYTE 3,3,1,2,1,2,1,3
18300 ; *****************************
18301 ; *** PROGRAMM ASSEMBLIEREN ***
18302 ; STARTADRESSE HINTERLEGEN
18304 L16304 LDA COMMEND:STA $902E:LDA COMMEND+1:STA $9032
18307 ; ASM VERAENDERN
18308 LDA #$2C:STA $9620
18309 LDA #$4C:STA $986C:LDA #>BACK:STA $986E:LDA #<BACK:STA $986D:JMP UP
18311 ; ASM NORMALISIEREN
18312 L16312 LDA #$A2:STA $9620
18313 LDA #$20:STA $986C:LDA #$9D:STA $986E:LDA #$DB:STA $986D
18314 ; ENDADRESSE BESORGEN
18315 LDA $4F:STA PRGEND:LDA $50:STA PRGEND+1
18316 JMP UP
28600 *= $C400
28601 ; CMDTAB+FUNTAB < 128BYTES, MAX. 51 EINTRAEGE -> BIS $CC7F
28602 ; *** ADRESSENTABELLE ***
28702 CMDTAB .WORD PROCEDURE-1
28703 .WORD FUNCTION-1
28704 .WORD PACK-1
28705 .WORD MEMORY-1
28706 .WORD INIT-1
28720 FUNTAB .WORD 00
28730 ; $C480 VARIABLENSPEICHER 48 BYTES
28739 *=$C4B0
28750 USTAB .ASC "USIN[199]"
28752 .ASC "PROGRA[205]"
28754 .BYTE 00
28798 ; **** STRINGTABELLE ***
28800 NEWTAB .ASC "PROCEDUR[197]"
28801 .ASC "FUNCTIO[206]"
28802 .ASC "PAC[203]"
28803 .ASC "MEMOR[217]"
28804 .ASC "INI[212]"
28820 FUNSTRTAB .WORD 00
39110 *=$304:.BYTE <TOKENREAD,>TOKENREAD
39120 *=$306:.BYTE <TOKENLIST,>TOKENLIST
39130 *=$308:.BYTE <NEWCMD,>NEWCMD
39140 *=$30A:.BYTE <NEWFUN,>NEWFUN
40500 ; ****** PROGRAMMTEIL 2 ********
40501 ; *** NACH $D400 UEBERTRAGEN ***
40510 *=$7000; 28672
40511 ; ADRESSEN IN PRGTEIL1 AENDERN
40514 LDA #<PRG3A:STA STARTADR:LDA #>PRG3A:STA STARTADR+1
40516 LDA #<PRG3E:STA ENDADR:LDA #>PRG3E:STA ENDADR+1
40520 LDA #<PRG1A:STA COUNTER:LDA #>PRG1A:STA COUNTER+1
40522 LDA #<PRG1E:STA PRGEND:LDA #>PRG1E:STA PRGEND+1
40530 LDA #<PRG4A:STA PRGANF:LDA #>PRG4A:STA PRGANF+1
40535 JSR DOWN:JSR ADAPT:JSR DOWN
40600 ; PRGTEIL3 NACH DESTINATION
40602 LDA #<PRG3A:STA LO:LDA #>PRG3A:STA HI
40604 LDA #<PRG4A:STA LO2:LDA #>PRG4A:STA HI2:LDX #4:LDY #$FF:JSR TRANSFER
40619 ; ADRESSEN IN PRGTEIL3 AENDERN
40624 LDA #<PRG3A:STA STARTADR:LDA #>PRG3A:STA STARTADR+1
40626 LDA #<PRG3E:STA ENDADR:LDA #>PRG3E:STA ENDADR+1
40630 LDA #<PRG4A:STA COUNTER:STA PRGANF:LDA #>PRG4A:STA COUNTER+1:STA PRGANF+1
40632 LDA #<PRG4E:STA PRGEND:LDA #>PRG4E:STA PRGEND+1
40645 JSR DOWN:JSR ADAPT:JMP UP
42001 ; *** ALLES RUNTERKOPIEREN ***
44000 ; *** PROGRAMMTEILE SAMMELN ***
44001 ; *** TEIL2 BEI $D400 ***
44004 *=$7200;29184
44030 JSR DOWN:LDY #0:STY 2
44032 L44032 LDA COPYTAB,Y:STA LO
44034 LDA COPYTAB+1,Y:STA HI
44036 LDA COPYTAB+2,Y:STA LO2
44038 LDA COPYTAB+3,Y:STA HI2
44040 LDA COPYTAB+4,Y:TAX
44042 LDA COPYTAB+5,Y:TAY
44044 JSR TRANSFER:LDA 2:CLC:ADC #6:STA 2:TAY:CMP #30:BNE L44032
44050 ; *** TEIL0 ANPASSEN ***
44054 LDA #<PRG0A:STA STARTADR:LDA #>PRG0A:STA STARTADR+1
44056 LDA #<PRG0E:STA ENDADR:LDA #>PRG0E:STA ENDADR+1
44060 LDA #<MID0:STA COUNTER:LDA #>MID0:STA COUNTER+1
44062 LDA #$FF:STA PRGEND:LDA #8:STA PRGEND+1
44070 LDA #0:STA PRGANF:LDA #8:STA PRGANF+1
44075 JSR ADAPT:JMP UP
50000 *=$7300
50001 ; *** ENDPROGRAMM ***
50002 ; *** 40 BYTES $0800-0827 ***
50003 .BYTE 0,34,8,196,7,158,32,50
50004 .BYTE 48,56,56,44,51,50,55,54
50006 .BYTE 56,32,66,89,32,87,79,76
50008 .BYTE 70,71,65,78,71,32,77,65
50010 .BYTE 89,00,00,00,00,00,00,00
50020 ; *** PROGRAMM VERTEILEN  AB $0828 **
50025 SEI:LDA 1:AND #248:STA 1:LDY #0:STY 2
50032 L50032 LDA COPYTAB,Y:STA LO2
50034 LDA COPYTAB+1,Y:STA HI2
50036 LDA COPYTAB+2,Y:STA LO
50038 LDA COPYTAB+3,Y:STA HI
50040 LDA COPYTAB+4,Y:TAX
50042 LDA COPYTAB+5,Y:TAY
50044 JSR TRANSFER:LDA 2:CLC:ADC #6:STA 2:TAY:CMP #24:BNE L50032
50070 ; *** VEKTOREN SETZEN ***
50080 LDA #<TOKENREAD:STA $0304:LDA #>TOKENREAD:STA $0305
50082 LDA #<TOKENLIST:STA $0306:LDA #>TOKENLIST:STA $0307
50084 LDA #<NEWCMD:STA $0308:LDA #>NEWCMD:STA $0309
50086 LDA #<NEWFUN:STA $030A:LDA #>NEWFUN:STA $030B
50090 LDA 1:ORA #7:STA 1:CLI
50095 ; ** ANF.ADR DES PROCEDURESPEICHERS ABLEGEN ***
50100 JSR CKCOM:JSR $AD8A:JSR $BC9B
50101 LDA $65:STA COMMANDS:STA COMMEND:LDA $64:STA COMMANDS+1:STA COMMEND+1
50102 ; ** BASIC ENDE  $37/38 ODER ANF-ADR PROCEDURESP. **
50103 CMP $38:BCS L50106
50104 STA $34:STA $36:STA $38:LDA $65:STA $33:STA $35:STA $37
50106 L50106 JSR $A644; NEW:JMP $A7AE
50200 ; *** COPY ROUTINE ***
50204 TRANSFER LDA (LO),Y:STA (LO2),Y:DEY:CPY #$FF:BNE TRANSFER
50206 INC HI:INC HI2:DEX:BNE TRANSFER:RTS
50300 ; *** COPYTAB ***
50302 COPYTAB .WORD $C000,$0900:.BYTE 4,$FF
50304 .WORD $D400,$0D00:.BYTE 4,$FF
50306 .WORD $C400,$1100:.BYTE 1,12
50308 .WORD $C480,$1110:.BYTE 1,$80
50310 .WORD $7300,$0800:.BYTE 1,$FF
50312 MID0 = $0828
59999 .END:END